Shap Value
#https://stackoverflow.com/questions/65391767/shap-plots-for-random-forest-models
#https://www.r-bloggers.com/2022/06/visualize-shap-values-without-tears/
#https://rdrr.io/cran/kernelshap/man/kernelshap.html
#Etapa 1: Criar uma amostra aleatoria
set.seed(123) # Definindo uma semente para reproducibilidade
amostra <- dados_treino1[sample(nrow(dados_treino1), 200), ]
# Etapa 2: Calcular os valores SHAP do kernel
# bg_X geralmente é um subconjunto pequeno (50-200 linhas) dos dados
#s <- kernelshap(final_model, dados_treino1[-1], bg_X = amostra)
#Salvar o resultado
setwd("C:/0.Projetos/2.Telecom_customer_(Churn)/Scripts")
#saveRDS(s, file = "resultado_kernelshap.rds")
s1 <- readRDS("resultado_kernelshap.rds")
#Tabela com os valores Shap Value
#DT:: datatable(s1$S)
#Matriz ou Data.frame com linhas a serem explicadas.
#DT::datatable(s1$X)
# Etapa 3: Transforme-os em um objeto shapviz
sv <- shapviz(s1)
Gráfico 1
#Gráfico 1
sv_importance(sv, kind = "bee")

Gráfico 2
#Gráfico 2
sv_dependence(sv, v = "eqpdays", color_var = "auto")

Gráfico 3
#Gráfico 3
sv_importance(sv)

#ou
#sv_importance(sv, kind = "bar")
Gráfico 4
#Gráfico 4
sv_importance(sv, kind = "both")

Gráfico 5
#Gráfico 5
sv_waterfall ( sv, row_id = 1 )
## Grafico 6
# Gráfico 6
sv_force (sv, row_id = 1)

Tabela para simulação da faixa de corte e do desconto
#Criar Tabela
tabela<- dados_validacao2 %>%
select(indice_validacao,churn)
tabela1 <- cbind(tabela, pred)
#Tabela 2 - Faixas de corte para valores previstos
tabela2 <- tabela1 %>% mutate(
f1_pred = ifelse(pred<= 0.05,1, 0),
f2_pred = ifelse(0.05< pred & pred<= 0.1, 1,0),
f3_pred = ifelse(0.1< pred & pred<= 0.15,1, 0),
f4_pred = ifelse(0.15< pred & pred<= 0.2,1, 0),
f5_pred = ifelse(0.2 < pred & pred <= 0.25,1, 0),
f6_pred = ifelse(0.25 < pred & pred <= 0.3,1, 0),
f7_pred = ifelse(0.3 < pred & pred <= 0.35,1, 0),
f8_pred = ifelse(0.35 < pred & pred <= 0.4,1, 0),
f9_pred = ifelse(0.4 < pred & pred <= 0.45,1, 0),
f10_pred = ifelse(0.45 < pred & pred <= 0.5,1, 0),
f11_pred = ifelse(0.5 < pred & pred <= 0.55,1, 0),
f12_pred = ifelse(0.55 < pred & pred <= 0.6,1, 0),
f13_pred = ifelse(0.6 < pred & pred <= 0.65,1, 0),
f14_pred = ifelse(0.65 < pred & pred <= 0.7,1, 0),
f15_pred = ifelse(0.7 < pred & pred <= 0.75,1, 0),
f16_pred = ifelse(0.75 < pred & pred <= 0.8,1, 0),
f17_pred = ifelse(0.8 < pred & pred <= 0.85,1, 0),
f18_pred = ifelse(0.85 < pred & pred <= 0.9,1, 0),
f19_pred = ifelse(0.9 < pred & pred <= 0.95,1, 0),
f20_pred = ifelse(0.95 < pred & pred <= 1,1, 0)
)
#Tabela 2 - Faixas de corte para valores verdadeiros
tabela2 <- tabela2 %>% mutate(
f1_verd = ifelse(churn==1 & pred<= 0.05,1, 0),
f2_verd = ifelse(churn==1 & 0.05< pred & pred<= 0.1, 1,0),
f3_verd = ifelse(churn==1 & 0.1 < pred & pred<= 0.15,1, 0),
f4_verd = ifelse(churn==1 & 0.15 < pred & pred<= 0.2,1, 0),
f5_verd = ifelse(churn==1 & 0.2 < pred & pred <= 0.25,1, 0),
f6_verd = ifelse(churn==1 & 0.25 < pred & pred <= 0.3,1, 0),
f7_verd = ifelse(churn==1 & 0.3 < pred & pred <= 0.35,1, 0),
f8_verd = ifelse(churn==1 & 0.35 < pred & pred <= 0.4,1, 0),
f9_verd = ifelse(churn==1 & 0.4 < pred & pred <= 0.45,1, 0),
f10_verd = ifelse(churn==1 & 0.45 < pred & pred <= 0.5,1, 0),
f11_verd = ifelse(churn==1 & 0.5 < pred & pred <= 0.55,1, 0),
f12_verd = ifelse(churn==1 & 0.55 < pred & pred <= 0.6,1, 0),
f13_verd = ifelse(churn==1 & 0.6 < pred & pred <= 0.65,1, 0),
f14_verd = ifelse(churn==1 & 0.65 < pred & pred <= 0.7,1, 0),
f15_verd = ifelse(churn==1 & 0.7 < pred & pred <= 0.75,1, 0),
f16_verd = ifelse(churn==1 & 0.75 < pred & pred <= 0.8,1, 0),
f17_verd = ifelse(churn==1 & 0.8 < pred & pred <= 0.85,1, 0),
f18_verd = ifelse(churn==1 & 0.85 < pred & pred <= 0.9,1, 0),
f19_verd = ifelse(churn==1 & 0.9 < pred & pred <= 0.95,1, 0),
f20_verd = ifelse(churn==1 & 0.95 < pred & pred <= 1,1, 0)
)
#Esta tabela será utilizada para criar a simulação no Excel
#Tabela Final
total_colunas <- colSums(select(tabela2, 4:43), na.rm = TRUE)
total_colunas1<- data.frame(total_colunas)
total_colunas1
## total_colunas
## f1_pred 0
## f2_pred 13
## f3_pred 143
## f4_pred 225
## f5_pred 268
## f6_pred 379
## f7_pred 565
## f8_pred 888
## f9_pred 1209
## f10_pred 1509
## f11_pred 1440
## f12_pred 1200
## f13_pred 895
## f14_pred 454
## f15_pred 227
## f16_pred 83
## f17_pred 10
## f18_pred 0
## f19_pred 0
## f20_pred 0
## f1_verd 0
## f2_verd 1
## f3_verd 20
## f4_verd 40
## f5_verd 63
## f6_verd 112
## f7_verd 200
## f8_verd 321
## f9_verd 511
## f10_verd 672
## f11_verd 730
## f12_verd 690
## f13_verd 563
## f14_verd 324
## f15_verd 170
## f16_verd 68
## f17_verd 9
## f18_verd 0
## f19_verd 0
## f20_verd 0